HyperLib 1997 Winter - Disc 1/HYPERLIB-1997-Winter-CD1.ISO.7z/HYPERLIB-1997-Winter-CD1.ISO/オンラインウェア/PRG/ICProgKit 1.3.sit/ICProgKit1.3/Goodies/ICRandomSignature/ICSpecificOverride.p

Text File | 1995-09-12 | 12KB | 385 lines

unit ICSpecificOverride;

(* Internet Config Specific Overide Component *)

(* Routine names have an ICSO prefix for Internet Config Specific Override. *)

(* To create an IC override component you need to make a copy of this *)
(* file and fill in the blanks. This is an N stage process: *)

(*  1. Make a copy of this file. *)
(*  2. Change kOurComponentManufacturer to your manufacturer code. *)
(*  3. Add any shared globals to the sharedGlobals record. *)
(*  4. If you have shared globals then init them in ICSOInitShared. *)
(*  5. If the shared globals need cleaning up then clean them ICSOCleanShared. *)
(*  6. Add any instance specific globals to globalsRecord. *)
(*  7. If you have globals then init them in ICSOInitGlobals. *)
(*  8. If the globals need cleaning up then clean them ICSOCleanGlobals. *)
(*  9. If you want to add a completely new routine or remove support *)
(*     for one of the built in routines then modify ICSOCanDo accordingly. *)
(* 10. Modify ICSOWhatToOverride to return the correct ProcPtr for each *)
(*     routine that you override or add. *)
(* 11. Write each routine. If you want the component to continue calling *)
(*     through to the captured component for this routine then have your *)
(*     routine return delegateThisCallErr. *)
(* 12. Smirk at the wonders of Component Manager. *)
(* 13. Looking inside ICGenericOverride and frown at the wonders of Component Manager. *)

(* Share and Enjoy. *)

(* Quinn *)
(* 12 Feb 1995 *)

interface

    uses
        Components;

    const
        kOurComponentManufacturer = 'JMJ ';
(* You must set this up appropriately. Things will not be good otherwise. *)

        delegateThisCallErr = $81234568;
(* Return this from a component routine if you want the generic override *)
(* component to pass this call through to the captured component. *)

    type
        sharedGlobals = record
                delegate: Component;
                (* add your own shared globals here *)
            end;
        sharedGlobalsPtr = ^sharedGlobals;

        globalsRecord = record
                self: ComponentInstance;
                target: ComponentInstance;
                delegate: ComponentInstance;
                shared: sharedGlobalsPtr;
                (* add your own component specific globals here*)
                current_signature: Handle;
                default_signature: Handle;
                sig_folder_name: Str63;
                random_seed: longint;
            end;
        globalsPtr = ^globalsRecord;
        globalsHandle = ^globalsPtr;

(* Except when otherwise noted the globals handle is *)
(* locked when any of these routines are called. *)

    function ICSOInitShared (globals: globalsHandle): ComponentResult;
(* This routine is called to init the shared globals. *)
(* If you return an error then you should make sure your part of *)
(* the shared globals are 'clean'. *)

    function ICSOCleanShared (globals: globalsHandle): ComponentResult;
(* This routine is called to clean the shared globals. *)
(* WARNING:  This will never been called if you're using an old version *)
(* of the Component Manager. Workaround: If your specifics only bleeds *)
(* small amounts of memory then don't worry. If your specifics bleeds a *)
(* lot of memory or other resources (such as open files) then refuse to *)
(* install with older Component Managers (I think it was fixed in v2 of the *)
(* manager. *)

    function ICSOInitGlobals (globals: globalsHandle): ComponentResult;
(* This routine inits the override specific fields of the component *)
(* specific globals. If it returns an error then the globals must be 'clean'. *)

    function ICSOCleanGlobals (globals: globalsHandle): ComponentResult;
(* This routine cleans up the component specific globals, disposing any *)
(* pointers and otherwise releasing any allocated resources. *)

    function ICSOCanDo (globals: globalsHandle; selector: integer): ComponentResult;
(* This routine is called in response to a component can do request. *)
(* You should set component result to: *)
(*   -1 if you definitely want to say that the component can't do this *)
(*     0 if you definitely want to say that the component can do this *)
(*     1 if you want to let the target decide *)
(* WARNING: These constants are quite different from the constants *)
(* used by a standard Component Manager CanDo request. *)

    function ICSOWhatToOverride (globals: globalsHandle; selector: integer): ProcPtr;
(* Return nil if you do not want to override this what. *)
(* Return a pointer to a procedure with the appropriate signature *)
(* if you do. *)
(* WARNING: globals will not necessarily be locked and may be nil!!! *)

implementation

    uses
        Folders, QuickDrawRules, ICTypes, ICCAPI, ICKeys, ICComponentSelectors;

    function ICSOInitShared (globals: globalsHandle): ComponentResult;
    begin
        ICSOInitShared := noErr;
    end; (* ICSOInitShared *)

    function ICSOCleanShared (globals: globalsHandle): ComponentResult;
    begin
        ICSOCleanShared := noErr;
    end; (* ICSOCleanShared *)

    function ICSOInitGlobals (globals: globalsHandle): ComponentResult;
        var
            err: ComponentResult;
            refnum: integer;
            strh: StringHandle;
            junk: OSErr;
    begin
        globals^^.random_seed := TickCount;
        globals^^.current_signature := nil;
        globals^^.default_signature := nil;
        err := noErr;
        refnum := OpenComponentResFile(Component(globals^^.self));
        if refnum <= 0 then begin
            err := resNotFound;
        end; (* if *)
        if err = noErr then begin
            strh := GetString(130);
            if strh = nil then begin
                err := resNotFound;
            end
            else begin
                globals^^.sig_folder_name := strh^^;
            end; (* if *)
            if err = noErr then begin
                globals^^.default_signature := Get1Resource('TEXT', 128);
                if globals^^.default_signature = nil then begin
                    err := resNotFound;
                end
                else begin
                    DetachResource(globals^^.default_signature);
                end; (* if *)
            end; (* if *)
            junk := CloseComponentResFile(refnum);
        end; (* if *)
        ICSOInitGlobals := err;
    end; (* ICSOInitGlobals *)

    function ICSOCleanGlobals (globals: globalsHandle): ComponentResult;
    begin
        if globals^^.current_signature <> nil then begin
            DisposeHandle(globals^^.current_signature);
            globals^^.current_signature := nil;
        end; (* if *)
        if globals^^.default_signature <> nil then begin
            DisposeHandle(globals^^.default_signature);
            globals^^.default_signature := nil;
        end; (* if *)
        ICSOCleanGlobals := noErr;
    end; (* ICSOCleanGlobals *)

    function SneakyRandom (globals: globalsHandle): integer;
        (* Get a random number without disturbing the random sequence in use *)
        (* by the current application. *)
        var
            tmp: longint;
    begin
        tmp := QDGlobals^.randSeed;
        QDGlobals^.randSeed := globals^^.random_seed;
        SneakyRandom := Random;
        globals^^.random_seed := QDGlobals^.randSeed;
        QDGlobals^.randSeed := tmp;
    end; (* SneakyRandom *)

    procedure SafeResolveAliasFile (var fs: FSSpec);
        var
            isfolder, wasalias: boolean;
            temp: FSSpec;
            gv: longInt;
            oe: OSErr;
    begin
        if (Gestalt(gestaltAliasMgrAttr, gv) = noErr) & (BTST(gv, gestaltAliasMgrPresent)) then begin
            temp := fs;
            oe := ResolveAliasFile(fs, true, isfolder, wasalias);
            if oe <> noErr then begin
                fs := temp;
            end;
        end;
    end;

    procedure ChooseRandomSignature (globals: globalsHandle);
        var
            cpb: CInfoPBRec;
            sig: FSSpec;

        function GetNthTextFile (max_count: integer; var count: integer): OSErr;
            var
                err: OSErr;
                index: integer;
        begin
            count := 0;
            index := 1;
            repeat
                cpb.ioNamePtr := @sig.name;
                cpb.ioDirID := sig.parID;
                cpb.ioVRefNum := sig.vRefNum;
                cpb.ioFDirIndex := index;
                err := PBGetCatInfoSync(@cpb);
                index := index + 1;
                if (err = noErr) and not btst(cpb.ioFlAttrib, 4) and (cpb.ioFlFndrInfo.fdType = 'TEXT') then begin
                    count := count + 1;
                end; (* if *)
            until (err <> noErr) or (count = max_count);
            GetNthTextFile := err;
        end; (* GetNthTextFile *)

        var
            junk: OSErr;
            texth: Handle;
            err: OSErr;
            ref: integer;
            count: integer;
            length: longint;
    begin
        if globals^^.current_signature <> nil then begin
            DisposeHandle(globals^^.current_signature);
            globals^^.current_signature := nil;
        end; (* if *)
        texth := nil;
        sig.name := globals^^.sig_folder_name;
        err := FindFolder(kOnSystemDisk, kPreferencesFolderType, kCreateFolder, sig.vRefNum, sig.parID);
        if err = noErr then begin
            SafeResolveAliasFile(sig);
            cpb.ioNamePtr := @sig.name;
            cpb.ioVRefNum := sig.vRefNum;
            cpb.ioDirID := sig.parID;
            cpb.ioFDirIndex := 0;
            err := PBGetCatInfoSync(@cpb);
        end; (* if *)
        if (err = noErr) and not btst(cpb.ioFlAttrib, 4) then begin
            err := dirNFErr;
        end; (* if *)
        if err = noErr then begin
            sig.parID := cpb.ioDirID;
            junk := GetNthTextFile(32767, count);
            if count = 0 then begin
                err := fnfErr;
            end
            else begin
                count := (abs(SneakyRandom(globals)) mod count) + 1;
                err := GetNthTextFile(count, junk);
            end; (* if *)
        end; (* if *)
        if err = noErr then begin
            SafeResolveAliasFile(sig);
            err := HOpen(sig.vRefNum, sig.parID, sig.name, fsRdPerm, ref);
        end; (* if *)
        if err = noErr then begin
            err := GetEOF(ref, length);
            if err = noErr then begin
                if length > 4096 then begin
                    length := 4096;
                end; (* if *)
                texth := NewHandle(length);
                err := MemError;
            end; (* if *)
            if err = noErr then begin
                err := FSRead(ref, length, texth^);
            end; (* if *)
            junk := FSClose(ref);
        end; (* if *)
        if err <> noErr then begin
            DisposeHandle(texth);
            texth := nil;
        end; (* if *)
        if texth = nil then begin
            texth := globals^^.default_signature;
            err := HandToHand(texth);
            if err <> noErr then begin
                texth := nil;
            end; (* if *)
        end; (* if *)
        globals^^.current_signature := texth;
    end; (* ChooseRandomSignature *)

    function RSCBegin (globals: globalsHandle; perm: ICPerm): ICError;
        var
            err: ICError;
    begin
        ChooseRandomSignature(globals);
        RSCBegin := delegateThisCallErr;
    end; (* RSCBegin *)

    function RSCGetPref (globals: globalsHandle; key: Str255; var attr: ICAttr; buf: Ptr; var size: longint): ICError;
        var
            tmpstr: Str255;
            perm: icPerm;
            max_size: longint;
            err: ICError;
    begin
        if IUEqualString(key, kICSignature) = 0 then begin
            (* This is for compatibility with IC 1.0, which didn't call ICBegin/ICEnd through *)
            (* the target when it was done automagically because of a ICGet/SetPref call. *)
            (* So if there are no permissions then we know that we're in about to do *)
            (* an automagic ICBegin so we randomise the signature. *)
            if (ICCGetPerm(globals^^.delegate, perm) = noErr) & (perm = icNoPerm) then begin
                ChooseRandomSignature(globals);
            end; (* if *)

            max_size := size;
            if globals^^.current_signature = nil then begin
                size := 0;
            end
            else begin
                size := GetHandleSize(globals^^.current_signature);
            end; (* if *)

            err := noErr;
            if ((max_size < 0) and (buf <> nil)) then begin
                err := paramErr;
            end; (* if *)
            if (err = noErr) and (buf <> nil) then begin
                if size > max_size then begin
                    err := icTruncatedErr;
                end
                else begin
                    max_size := size;
                end; (* if *)
                if max_size <> 0 then begin
                    BlockMove(globals^^.current_signature^, buf, max_size);
                end; (* if *)
            end; (* if *)

            attr := ICattr_locked_mask + ICattr_volatile_mask;
            RSCGetPref := err;
        end
        else begin
            RSCGetPref := delegateThisCallErr;
        end; (* if *)
    end; (* RSCGetPref *)

    function RSCSetPref (globals: globalsHandle; key: Str255; var attr: ICAttr; buf: Ptr; var size: longint): ICError;
    begin
        if IUEqualString(key, kICSignature) = 0 then begin
            RSCSetPref := icPermErr;
        end
        else begin
            RSCSetPref := delegateThisCallErr;
        end; (* if *)
    end; (* RSCSetPref *)

    function ICSOCanDo (globals: globalsHandle; selector: integer): ComponentResult;
    begin
        ICSOCanDo := delegateThisCallErr;
    end; (* ICSOCanDo *)

    function ICSOWhatToOverride (globals: globalsHandle; selector: integer): ProcPtr;
        var
            proc: ProcPtr;
    begin
        proc := nil;
        case selector of
            kICCBegin:
                proc := @RSCBegin;
            kICCGetPref:
                proc := @RSCGetPref;
            kICCSetPref:
                proc := @RSCSetPref;
            otherwise
                ;
        end; (* case *)
        ICSOWhatToOverride := proc;
    end; (* ICSOWhatToOverride *)

end. (* ICSpecificOverride *)